#!/usr/bin/env perl
#Author: Jamie Davis <davisjam@vt.edu>
#Description: Use to test the node record/replay system

use strict;
use warnings;

use Getopt::Long;
use File::Basename;

#Globals
my @requested_tests;
my $niter = 5;
my $redirect = 0;
my $node = "node";

#arg processing
if (not @ARGV or not GetOptions(
  "niter=i" => \$niter,
  "redirect" => \$redirect,
  ))
{
  &usage();
  exit 1;
}
@requested_tests = @ARGV; #remaining items in @ARGV are the requested tests
&assert((@requested_tests), "Error, you must request at least one test");

for my $t (@requested_tests) {
  &assert((-f $t), "Error, no file '$t' found");
}

my @passed_tests;
my @failed_tests;
for my $test (@requested_tests) {
  &log("Running test '$test'");
  my $rc = &run_test($test);
  if ($rc == 0) {
    &log("Result: test '$test' passed");
    push @passed_tests, $test;
  }
  else {
    &log("Result: test '$test' failed");
    push @failed_tests, $test;
  }
}

my $rc = 0;
my $exitMsg = "";
my $ntests = scalar(@requested_tests);
my $nfailed = scalar(@failed_tests);
if ($nfailed) {
  $rc = 1;
  $exitMsg = "Error, $nfailed/$ntests failed
  Failed: <@failed_tests>
  Passed: <@passed_tests>
";
}
else {
  $rc = 0;
  $exitMsg = "Success, $ntests/$ntests tests passed: <@passed_tests>";
}

&log($exitMsg);
exit $rc;

####################################
# Application functions
####################################

#input: ($test)
#output: ($rc)
#returns 0 on success, non-zero on failure
#uses globals: $niter, $redirect
sub run_test
{
  my ($test) = @_;
  &assert((-f $test), "run_test: Error, no such file '$test'");

  my $base = basename($test);

  my $sched_file_pref = "/tmp/$base\_schedule";

  my ($cmd, $cpid, $nodePid, $exists);
  my (@allProcesses, @nodeProcesses);
  my $nodeProcess;
  my $coreGlob = "core.node.*";

  my $timeout = 30;

  my (@origCoreFiles, @newCoreFiles);

  @origCoreFiles = glob $coreGlob;
  for (my $i = 0; $i < $niter; $i++) {
    &log("run_test: test '$test' iter $i");

    my $sched_file = "$sched_file_pref\_$i.sched";
    unlink $sched_file;

    #Record
    $cmd = "UV_SCHEDULE_MODE=RECORD UV_SCHEDULE_FILE=$sched_file $node $test 2>/tmp/run_tests_stderr";
    if ($redirect) {
      $cmd .= " > /tmp/$base\_record_out";
    }
    &log("run_test: test '$test': Record child cmd\n  $cmd");

    {
      $cpid = fork;
      &assert((defined $cpid), "run_test: Error, record fork failed: $!");
      if ($cpid) {
        last;
      }
      exec $cmd;
    }
    sleep 1; #Let child get started (fork/ps race)

    if (&waitForProcessToFinish($cpid, $timeout, "$node $test")) {
      &log("run_test: timed out waiting for record to finish");
      return 1;
    }
    if (&anyNewCoreFiles($coreGlob, @origCoreFiles)) {
      &log("run_test: New core file (record) suggests failure");
      return 1;
    }

    #Locate the schedule file
    while (not (-f $sched_file and -s $sched_file > 0)) {
      &log("Waiting for $sched_file");
      sleep 1;
    }
    &assert((-f $sched_file and -s $sched_file > 0), "Error, after record, sched_file <$sched_file> does not exist or is empty");

    #Replay
    $cmd = "UV_SCHEDULE_MODE=REPLAY UV_SCHEDULE_FILE=$sched_file $node $test 2>/tmp/run_tests_stderr";
    if ($redirect) {
      $cmd .= " > /tmp/$base\_replay_out";
    }
    &log("run_test: test '$test': Replay child cmd\n  $cmd");

    {
      $cpid = fork;
      &assert((defined $cpid), "run_test: Error, replay fork failed: $!");
      if ($cpid) {
        last;
      }
      exec $cmd;
    }
    sleep 1; #Let child get started (fork/ps race)

    if (&waitForProcessToFinish($cpid, $timeout, "$node $test")) {
      &log("run_test: Timed out waiting for replay to finish");
      return 1;
    }
    if (&anyNewCoreFiles($coreGlob, @origCoreFiles)) {
      &log("run_test: New core file (replay) suggests failure");
      return 1;
    }
  }

  return 0;
}

sub usage
{
  print "Description: Use to test the node record/replay system
Usage: $0 [--niter X] [--redirect] t1 t2 ...
  --niter: Run this many iterations of each test. Default is 5.
  --redirect: Send output to a file instead of stdout.
  t1 t2 ...: List of tests (Node.js apps) you wish to run.
Example: $0 --niter 5 fs_several.js fs_several_stat.js
";
}

#input: ($ppid, $timeout, $processMatchStr)
#output: ($rc) 0 on success, 1 on timeout
#Wait until the first of {timeout, ps does not report a process with command eq $processMatchStr}
sub waitForProcessToFinish
{
  my ($ppid, $timeout, $matchStr) = @_;
  eval
  {
    local $SIG{ALRM} = sub { die "alarm\n" }; # NB: \n required
    alarm $timeout;
    while (1)
    {
      my @allProcesses = &ps();
      my @nodeProcesses = grep { $_->{CMD} eq $matchStr } @allProcesses;
      if (not @nodeProcesses)
      {
        last;
      }
      sleep 1;
    }
    alarm 0;
  };

  my $rc = 0;

  if ($@)
  {
    die unless $@ eq "alarm\n";   # propagate unexpected errors
    $rc = 1; 

    #Kill the process, forcing it to dump its schedule to date. 

    #Identify node process
    my @allProcesses = &ps();
    my @nodeProcesses = grep { $_->{CMD} eq $matchStr } @allProcesses;
    &assert((scalar(@nodeProcesses) == 1), "waitForProcessToFinish: Error, did not find exactly 1 node process. I found nodeProcesses <@nodeProcesses>");
    if (scalar(@nodeProcesses)) {
      my $nodeProcess = shift @nodeProcesses;
      &assert(($nodeProcess->{PPID} eq $ppid), "waitForProcessToFinishError, node process PPID is $nodeProcess->{PPID} != ppid $ppid");

      #Ask it to emit its schedule.
      &log("waitForProcessToFinish: Sending node process USR2 so it will dump its schedule to date");
      kill 'USR2', $nodeProcess->{PID};
      sleep 3;

      #Kill it dead.
      kill 'KILL', $nodeProcess->{PID};
      kill 'KILL', $nodeProcess->{PPID};

      &log("waitForProcessToFinish: Error, process did not exit by itself.");
      return 1;
    }
  }
  else
  {
    $rc = 0;
  }

  return $rc;
}

#input: ($globStr, @origCoreFiles)
#output: ($anyNewCoreFiles) -- 0 or 1
sub anyNewCoreFiles
{
  my ($globStr, @origCoreFiles) = @_;

  my @newCoreFiles = glob $globStr;
  &assert((scalar(@origCoreFiles) <= scalar(@newCoreFiles)), "Error, some core files disappeared? Before <@origCoreFiles> after <@newCoreFiles>");

  if (scalar(@origCoreFiles) < scalar(@newCoreFiles)) {
    my @new = grep { not &in($_, \@origCoreFiles) } @newCoreFiles;
    &log("anyNewCoreFiles: Error, new core file(s) have been generated: <@new>. Something has gone wrong!");
    return 1;
  }
  return 0;
}

####################################
# Helper routines
####################################

#input: ($cmd)
#output: ($out)
# asserts on rc != 0
sub chkcmd
{
  my ($cmd) = @_;
  my ($rc, $out) = &runcmd($cmd);
  &assert(($rc eq 0), "chkcmd: error, <$cmd> gave rc $rc out\n\n$out");

  return $out;
}

#input: ($cmd)
#output: ($rc, $out)
sub runcmd
{
  my ($cmd) = @_;
  chomp $cmd;

  $cmd .= " 2>&1";
  print "$cmd\n";

  my $out = `$cmd`;
  my $rc = ($? >> 8);
  return ($rc, $out);
}
  
#input: ($cond, $msg)
sub assert
{
  my ($cond, $msg) = @_;
  if (not $cond)
  {
    print "$msg\n";
    exit 1;
  }
}

#input: ($msg)
sub log
{
  my ($msg) = @_;
  print localtime . ": $msg\n";
}

#input: ($msg)
#log $msg and then exit 1
sub halt
{
  my ($msg) = @_;
  &log($msg);
  exit(1);
}

#input: ($elt, \@list)
#output: 1 if $elt is in \@list, else 0
sub in
{
  my ($elt, $list) = @_;
  my @list = @$list;
  for my $e (@list)
  {
    return 1 if ($e eq $elt);
  }
  return 0;
}

#input: ()
#output: (@processes)
#  list of hashrefs with keys: UID PID PPID C STIME TTY TIME CMD
sub ps
{
  my @out = `ps -ef`;
  chomp @out;

  my $labels = shift @out;
  my @labels = split(" ", $labels);
  #last one is open-ended
  &assert($labels[-1] eq "CMD");

  my @processes;
  for my $line (@out) {
    my %process;
    my @fields = split(" ", $line);
    &assert((scalar(@labels) <= scalar(@fields)), "Error, unexpected line <$line> (fields <@fields>) does not have enough content for labels <@labels>");
    for (my $i = 0; $i < scalar(@labels)-1; $i++) {
      $process{$labels[$i]} = shift @fields;
    }
    $process{$labels[-1]} = join(" ", @fields);
    push @processes, \%process;
  }

  return @processes;
}
